;;; -*- Mode: Lisp; Base: 8; Package: User; Lowercase:t -*-

;Assemble this with HIC;AS8748 and stuff it into a keyboard with LMIO1;PROMP

;This is the new (11/18/80) version for use with the new keyboard PC,
;which contains a 24-bit shift register for faster transmission to the
;host and provides for running the mouse through the keyboard ("remote mouse"
;in the IOB).

;9/18/81 modified as follows:
;       Check the mouse more often in the keyboard-scanning loop
;          [Hmm, it's already checking the mouse more often, but
;           I don't think that change was ever installed.]
;       Feep with a low pitch on powering up, and a higher pitch
;        after successfully sending a character to the Lisp machine.
;       Time out waiting for the DONE flag.  It can get turned off by
;        random noise on the clock line if the Lisp machine is powered
;        off or disconnected; we don't want that to break the keyboard.

(defun complement (x)
  (logxor 377 x))

;;; Hardware documentation

;To read from keyboard, P1<4:1> gets column number, then P1<0> gets 0,
;then read back keys from P2, then P1<1> gets 1 again.

;P1<7> = beeper (pin 5 on the connector)
;P1<6> = write register select bit 0 (pin 3 on the connector)
;P1<5> = write register select bit 1 (pin 1 on the connector)
;T1    = pin 2 on the connector (not used any more)
;
;Reading the data bus returns
;DONE in bit 0 and the mouse in bits 1-7.  DONE is 1 if the shift
;register has been sent off to the host computer.
;
;Writing the data bus writes into
;one of the three bytes of the shift register; write the first byte
;last with a start bit in its low-order bits.  P1<6:5> selects which byte.

;The following are the bit numbers of the keys which are specially
;known about for shifting purposes:
;  mode lock    3
;  caps lock    125
;  alt lock     15
;  repeat       115
;  top          104 / 155
;  greek        44 / 35
;  shift        24 / 25
;  hyper        145 / 175
;  super        5 / 65
;  meta         45 / 165
;  control      20 / 26

; For booting, we know that rubout is 23 and return is 136

;Protocol documentation is at the end of this file

;;; Locations in data memory
(setq bitmap 60)        ;60-77 Bit map.  0 if key up, 1 if key down.
(setq bootflag 57)      ;Normally 0, non-zero to suppress key-up codes
                        ; and mouse codes while in boot sequence
(setq mouse 56)         ;Last known state of the mouse input lines
(setq init 55)          ;Non-zero if have sent a character

;;; Note that we always return the beeper output to 0 when not using it.
;;; This is for convenience in the keyboard-scanning loop, since it's
;;; on the same port.

;;; Program
(putprop 'ukbd '(
        (= 0)
        (jmp beg)
        (= 1)   ;Table of magic constants for keyboard scanner
        001 003 005 007 011 013 015 017
        021 023 025 027 031 033 035 037

        (= 100)         ;Why location 100?
beg     (mov a (/# 377))
        (outl p1 a)                     ;Mainly turn off data out
        (outl p2 a)                     ;Enable input
        (mov r0 (/# 40))                ;Clear all memory above location 40,
        (mov r1 (/# 40))                ; especially the bitmap
        (clr a)
clear-bitmap-loop
        (mov @r0 a)
        (inc r0)
        (djnz r1 clear-bitmap-loop)
        (mov r0 (/# 8))                 ;Wait 3 seconds after powering up
power-up-delay-1
        (mov r1 (/# 0))                 ;Delay 400 ms
power-up-delay-2
        (mov r2 (/# 0))                 ;Delay 1.5 ms
power-up-delay-3
        (djnz r2 power-up-delay-3)
        (djnz r1 power-up-delay-2)
        (djnz r0 power-up-delay-1)
        (mov r0 (/# 24.))               ;Give medium pitched feep
        (mov r1 (/# 100.))              ;for 1/3 second
        (call feep)
its-all-up                              ;Send all-up code to initialize the
        (call send-all-up-code)         ; shift register in the Lisp machine
        (mov r0 (/# init))              ;Initialized yet?
        (mov a @r0)
        (jnz scan-keyboard)             ;Yes
        (call await-done)               ;Wait for response from Lisp machine
        (ins a bus)                     ;A<0>=DONE
        (rrc a)                         ;C=DONE
        (jnc scan-keyboard)             ;await-done timed out
        (mov r0 (/# init))              ;Success, set initialized flag
        (mov @r0 (/# 1))
        (mov r0 (/# 8))                 ;Then give high-pitched feep
        (mov r1 (/# 250.))              ;For 1/4 second
        (call feep)                     ;and drop into scan-keyboard

;Scanning Loop.
;R2 is bitmap index in bytes, plus 1
;R1 points to previous mouse status
;R0 is address of bitmap byte that goes with R2

scan-keyboard
        (mov r2 (/# 20))                ;Loop counter and index
        (mov r1 (/# mouse))             ;Addressibility
        (mov r0 (/# (+ bitmap 17)))     ;Address of bitmap byte
scan-loop
        (ins a bus)                     ;Get mouse status
        (anl a (/# (complement 1)))     ;Clear done bit
        (xrl a @r1)                     ;Has mouse status changed?
        (jnz scan-mouse)                ;Yes, punt keyboard and go send mouse char
        (mov a r2)
        (movp a @a)                     ;A<4:1>  R2-1, A<0>  1
        (outl p1 a)                     ;Select row and disable decoder
        (anl p1 (/# (complement 1)))    ;Strobe the decoder (why?)
        (in a p2)                       ;Get row of keys
        (xrl a @r0)                     ;A  changed bits
        (jnz scan-found)                ;Jump if key state changed
        (dec r0)
        (djnz r2 scan-loop)
        (jmp scan-keyboard)             ;Nothing happening, idle.

scan-mouse
        (xrl a @r1)                     ;Restore from xor above
        (mov @r1 a)                     ;Update previous-mouse-state
        (xrl a (/# 340))                ;Compensate for hardware bug--buttons complemented
        (mov r2 a)                      ;Arg for send
        (mov r3 (/# 0))
        (mov r4 (/# 176_1))             ;Source ID 6 (mouse)
        (mov r0 (/# bootflag))          ;Don't send if in boot sequence
        (mov a @r0)
        (jnz scan-keyboard)
        (call send)
        (jmp scan-keyboard)

;R0 address of bit map entry
;R2 bit number
;R3 changed bits
;R4 bit mask
scan-found
        (mov r3 a)
        (mov r4 (/# 1))
        (mov a r2)                      ;Bit number is byte number times 8
        (dec a)
        (rl a)
        (rl a)
        (rl a)
        (mov r2 a)
scan-bits-loop
        (mov a r4)
        (anl a r3)
        (jnz scan-found-key)
        (inc r2)
        (mov a r4)                      ;Shift left one bit, A  0 when done
        (add a r4)
        (mov r4 a)
        (jnz scan-bits-loop)
        (jmp scan-keyboard)             ;wtf? should have found something

scan-found-key
        (mov a r2)                      ;Shift r2 left 1
        (add a r2)
        (mov r2 a)
        (mov a r4)                      ;Bit mask
        (xrl a @r0)                     ;Change bitmap bit
        (mov @r0 a)                     ;Put back in bitmap
        (anl a r4)                      ;0 if key now up, non-0 if key now down
        (mov r3 (/# 0))                 ;Assume key down
        (jnz scan-found-key-down)
        (mov r3 (/# 2))                 ;Key up, middle byte is 1
        ;; If booting, don't send key-up codes
        (mov r1 (/# bootflag))
        (mov a @r1)
        (jnz scan-keyboard)
        ;; If this is a shifting key, don't send all-keys-up, send this-key-up.
        ;; This is so that with paired shifting keys we know which it is.
        (mov a r0)
        (add a (/# (- 200 bitmap)))     ;Point to mask of non-shifting keys
        (movp3 a @a)
        (anl a r4)                      ;A gets bit from table (0 => shifting)
        (jz scan-found-key-down)        ;Shifting => don't send all-keys-up
        ;; Look through the bit map and see if all non-shifting keys are now
        ;; up.  If so, send an all-keys-up instead.
        (mov r0 (/# bitmap))
        (mov r1 (/# 200))               ;P3 table at 1600
        (mov r4 (/# 20))
check-for-all-up
        (mov a r1)
        (movp3 a @a)
        (anl a @r0)
        (jnz scan-found-key-down)
        (inc r0)
        (inc r1)
        (djnz r4 check-for-all-up)
        (call await-done)
        (jmp its-all-up)

scan-found-key-down
        (mov r4 (/# 171_1))             ;Source ID 1 (new keyboard)
        (call send)                     ;Transmit character
        (call check-boot)               ;See if request to boot machine
        (jmp scan-keyboard)

;Subroutine to transmit like old-type Knight keyboard (using new shift reg hardware)
;Send a 24-bit character from R2, R3, R4
;But note that it's all shifted left 1 bit.  R2<0> must be zero,
;it's the start-bit.
send    (call await-done)
send1   (orl p1 (/# 140))               ;P1<5:6>=3
        (mov a r4)
        (outl bus a)
        (anl p1 (/# 277))               ;P1<5:6>=2
        (mov a r3)
        (outl bus a)
        (anl p1 (/# 337))               ;P1<5:6>=1
        (orl p1 (/# 100))
        (mov a r2)
        (outl bus a)
        (ret)


        (= 400)
;Send all-up key-code.  NOTE that this does not wait for DONE.
;This works by checking through the bitmap looking for shift keys
;that are down, and OR'ing in the bits.
send-all-up-code
        (clr a)                         ;Cannot clear registers directly
        (mov r2 a)                      ;Start with no bits set
        (mov r3 a)
        (mov r5 a)                      ;R5 address in P3
        (mov r0 (/# bitmap))            ;R0 address in bitmap
cauc-0  (mov r4 (/# 1))                 ;R4 bit mask
cauc-1  (mov a r5)
        (movp3 a @a)                    ;Get table entry
        (jb7 cauc-9)                    ;Jump if this key not a shifter
        (mov r6 a)                      ;Save bit number
        (mov a r4)                      ;Check bit in bit map
        (anl a @r0)
        (jz cauc-9)                     ;Key not pressed
        (mov a r6)                      ;See if bit number 7 or more
        (add a (/# -7))
        (jb7 cauc-4)                    ;Jump if less than 7
        (mov r6 a)                      ;Save bitnumber within middle byte
        (call cauc-sh)
        (orl a r3)
        (mov r3 a)
        (jmp cauc-9)

cauc-4  (inc r6)
        (call cauc-sh)
        (orl a r2)
        (mov r2 a)
;Done with this key, step to next
cauc-9  (inc r5)                        ;Advance P3 address
        (mov a r4)                      ;Shift bit mask left 1
        (add a r4)
        (mov r4 a)
        (jnz cauc-1)                    ;Jump if more bits this word
        (inc r0)                        ;Advance bitmap address
        (mov a r0)                      ;See if done
        (add a (/# (- (+ bitmap 20))))
        (jnz cauc-0)                    ;Jump if more words in bitmap
        (mov r4 (/# 363))               ;Source ID 1, bit 15 on
        (jmp send1)                     ;Send it and return

;Produce in A a bit shifted left by amount in R6
cauc-sh (inc r6)                        ;Compensate for DJNZ
        (mov a (/# 200))
cauc-sh-1
        (rl a)
        (djnz r6 cauc-sh-1)
        (ret)

;Is request to boot machine if both controls and both metas are held
;down, along with rubout or return.  We have just sent the key-down codes
;for all of those keys.  We now send a boot character, then set a flag preventing
;sending of up-codes until the next down-code.  This gives the machine time
;to load microcode and read the character to see whether
;it is a warm or cold boot, before sending any other characters, such as up-codes.
;  meta         45 / 165
;  control      20 / 26
;  rubout       23
;  return       136
; The locking keys are in bytes 1, 3, and 12, conveniently out of the way
;A boot code:
;  15-10        1
;  9-6          0
;  5-0          46 (octal) if cold, 62 (octal) if warm.

check-boot
        (mov r1 (/# bootflag))          ;Establish addressibility for later
        (mov r0 (/# 64))                ;Check one meta key
        (mov a @r0)
        (xrl a (/# 1_5))
        (jnz not-boot)
        (mov r0 (/# 76))                ;Check other meta key
        (mov a @r0)
        (xrl a (/# 1_5))
        (jnz not-boot)
        (mov r0 (/# 62))                ;Check byte containing controls and rubout
        (mov a @r0)
        (xrl a (/# (+ 1_0 1_6 1_3)))
        (jz cold-boot)                  ;Both controls and rubout => cold-boot
        (xrl a (/# 1_3))
        (jnz not-boot)
        (mov r0 (/# 73))                ;Check for return
        (mov a @r0)
        (xrl a (/# 1_6))
        (jnz not-boot)
warm-boot
        (mov r2 (/# 62_1))
        (jmp send-boot)

cold-boot
        (mov r2 (/# 46_1))
send-boot
        (mov r3 (/# 174_1))             ;1's in bits 14-10
        (mov r4 (/# 363))               ;Source ID 1 (new keyboard), 1 in bit 15
        (mov @r1 (/# 377))              ;Set bootflag
        (jmp send)                      ;Transmit character and return

not-boot
        (mov @r1 (/# 0))                ;Clear bootflag
        (ret)

;Wait for PC board to say that it is done shifting out previous character
;This will time out after 1 second
;Bashes R0, R1, A
await-done
        (mov r0 (/# 0))
await-done-1
        (mov r1 (/# 0))
await-done-2
        (ins a bus)                     ;A<0>=DONE
        (rrc a)                         ;C=DONE
        (jnc await-done-3)              ;Not DONE yet
        (ret)

await-done-3
        (djnz r1 await-done-2)
        (djnz r0 await-done-1)
        (ret)                           ;timeout

;Feep routine.  R0 is the half-period in units of 100 microseconds.
;R1 is the number of cycles to do.
feep    (orl p1 (/# 200))               ;Cycle feeper
        (call feep-delay)
        (anl p1 (/# (complement 200)))
        (call feep-delay)
        (djnz r1 feep)
        (ret)

feep-delay
        (mov a r0)
        (mov r2 a)
feep-1  (mov r3 (/# 15.))               ;djnz takes 6+ microseconds
feep-2  (djnz r3 feep-2)
        (djnz r2 feep-1)
        (ret)

;In P3 (1400-1577) we have a table, indexed by key number, of shifting
;keys.  The byte is 200 for ordinary keys, or the bit number in the
;all-keys-up message for locking and shifting keys.
        (= 1400)
        200     ;0
        200
        200
        9.      ;3 mode lock
        200
        6.      ;5 super
        200
        200

        200     ;10
        200
        200
        200
        200
        8.      ;15 alt lock
        200
        200

        4.      ;20 control
        200
        200
        200
        0.      ;24 shift
        0.      ;25 shift
        4.      ;26 control
        200

        200     ;30
        200
        200
        200
        200
        1.      ;35 greek
        200
        200

        200     ;40
        200
        200
        200
        1.      ;44 greek
        5.      ;45 meta
        200
        200

        200     ;50
        200
        200
        200
        200
        200
        200
        200

        200     ;60
        200
        200
        200
        200
        6.      ;65 super
        200
        200

        200     ;70
        200
        200
        200
        200
        200
        200
        200

        200     ;100
        200
        200
        200
        2.      ;104 top
        200
        200
        200

        200     ;110
        200
        200
        200
        200
        10.     ;115 repeat
        200
        200

        200     ;120
        200
        200
        200
        200
        3.      ;125 caps lock
        200
        200

        200     ;130
        200
        200
        200
        200
        200
        200
        200

        200     ;140
        200
        200
        200
        200
        7.      ;145 hyper
        200
        200

        200     ;150
        200
        200
        200
        200
        2.      ;155 top
        200
        200

        200     ;160
        200
        200
        200
        200
        5.      ;165 meta
        200
        200

        200     ;170
        200
        200
        200
        200
        7.      ;175 hyper
        200
        200

        (= 1600)
;Locations 1600-1617 contain a mask which has 1's for bit-map positions
;which contain non-shifting keys.
        327     ;3 and 5
        337     ;15
        216     ;20, 24, 25, 26
        337     ;35
        317     ;44, 45
        377
        337     ;65
        377     ;70
        357     ;104
        337     ;115
        337     ;125
        377
        337     ;145
        337     ;155
        337     ;165
        337     ;175

        )
'code)

;These don't work any more:
;;Look at kbd and print out any characters that come in
;(defun test ()
;  (let ((tv-more-processing-global-enable nil))
;     (do ((ch)) (nil)
;       (process-allow-schedule)
;       (and (setq ch (si:kbd-tyi-raw-no-hang))
;           (print (ldb 0027 ch))))))
;
;;This version isn't stoppable, because it just gets it right out of the hardware
;;Prevents you from getting screwed by call-processing and the like.
;(defun supertest ()
;  (let ((tv-more-processing-global-enable nil))
;     (do ((ch)) (nil)
;       (or si:kbd-buffer (si:kbd-get-hardware-char-if-any))
;       (and si:kbd-buffer
;           (progn (setq ch si:kbd-buffer si:kbd-buffer nil)
;                  (print (ldb 0027 ch)))))))

;;; Protocol documentation

; Protocol for new keyboards  -- 9/27/79
;
; Present hardware character format conventions:
;
; A character is 24 bits, sent low-order bit first.  There is also
; a "start bit" or "request signal", which is low.  Bits appear
; on the cable in true-high form.  The cable is high when idle.
; The clock is high when idle, and the falling edge is the clock
; in the central machine.  The leading edge (check this) is the
; clock in the keyboard.
;
; The old (Knight) keyboards send 1's for the high 9 bits.
;
; Bit 16 is normally 1, 0 for the "remote mouse" which the IOB
; claims to support.  Whether the IOB
; hardware actually looks at this bit is under program control.
;
; The IOB boots the lisp machine if a character is received with
; bits 10-13 = 1, bits 6-9 = 0, and bit 16 = 1 (bit 16 may or may
; not be looked at depending on remote mouse enable.)   The low 6
; bits control whether it is a warm or cold boot.
;
; Here is the new standard character format:
;       15-0    Information
;       18-16   Source ID
;       23-19   Reserved, must be 1's.
;
; The following source ID's are defined:
;       111     Old keyboard, information is as follows:
;               5-0     keycode
;               7-6     shift
;               9-8     top
;               11-10   control
;               13-12   meta
;               14      shift-lock
;               15      unused
;       110     IOB's "remote mouse", this also uses up codes 000, 010, 100
;               Low bits are the input lines from the mouse
;       101     Reserved.
;       001     New keyboard, information as follows:
;               An up-down code:
;               15      0 (indicates up-down code)
;               14      0 (reserved for expansion of codes)
;               13      0 (so it doesn't look like a boot)
;               12-9    0 (reserved for expansion)
;               8       1=key up, 0=key down
;               7       0 (reserved for expansion of keys)
;               6-0     keycode (not same codes as old keyboards)
;
;               An all-keys-up:  (This is sent when a key-up code would be sent but
;                       now no keys other than shifting and/or locking keys are
;                       down. This ensures that the status of the shifting keys,
;                       especially the locking ones, does not get out of phase.
;                       A 1 is sent for each special key that is currently down.)
;               15      1 (indicates not an up-down code)
;               14      0 (reserved for expansion of codes)
;               13      0 (so it doesn't look like a boot)
;               12      0 (reserved for expansion of keys)
;               11      0 (reserved for expansion of keys)
;               10      Repeat
;               9       Mode lock
;               8       Alt lock
;               7       Hyper (either one)
;               6       Super (either one)
;               5       Meta (either one)
;               4       Control (either one)
;               3       Caps lock
;               2       Top (either one)
;               1       Greek (either one)
;               0       Shift (either one)
;
;               A boot code:
;               15-10   1
;               9-6     0
;               5-0     46 (octal) if cold, 62 (octal) if warm.
;
;               All key-encoding, including hacking of shifts, will be done
;               in software in the central machine, not in the keyboard.  Note
;               that both pressing and releasing a key send a code, therefore
;               the central machine knows the status of all keys.  If the machine
;               somehow gets out of phase, the next time the user presses and releases
;               a key an all-keys-up message will be sent, getting it back into phase.
;
;               Note that after sending a boot the keyboard must not
;               send any more characters (such as up-codes) until
;               another key is depressed, or the keyboard buffer
;               in the IOB would forget the type of boot.
;
;       011     Mouse attached via new keyboard.  Information as follows:
;               [This won't be implemented soon; it's not what this program does.]
;               5-0     Delta-X, 2's complement
;               11-6    Delta-Y, 2's complement
;               12      0.  Prevents accidental booting.
;               15-13   Current status of buttons.
;               Every time the mouse moves or the button status changes,
;               a mouse character is sent, except that there is a minimum
;               delay between mouse characters of probably 1/30th or 1/40th
;               second.  Between characters the keyboard tracks motion of
;               the mouse.  These mouse characters will not be processed
;               by hardware in the IOB.  They will probably be processed
;               by the CADR microcode interrupt handler.
